Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue30/delcom/PasDrop/ContextM.pas

Pascal/Delphi Source File | 1998-01-08 | 5.2 KB | 158 lines

unit ContextM;

interface

uses
    Windows, Messages, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;

const
   CLSID_ContextMenuShellExtension: TGUID = '{A955FDC0-8819-11D1-AB26-D0E304C10000}';

type
    TContextMenu = class (TComObject, IShellExtInit, IContextMenu)
    private
        hGlobal: THandle;
        TabControlWindow: hWnd;
        EditControl: hWnd;
        procedure DropOnDelphi;
    public
        function QueryContextMenu (Menu: hMenu; indexMenu, idCmdFirst, idCmdLast,
                                   uFlags: UInt): HResult; stdcall;
        function InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult; stdcall;
        function GetCommandString (idCmd, uType: UInt; pwReserved: PUInt;
                                   pszName: LPSTR; cchMax: UINT): HResult; stdcall;
        function Initialize (pidlFolder: PItemIDList; lpdobj: IDataObject;
                                  hKeyProgID: HKEY): HResult; stdcall;
    end;

implementation

function TabControlEnumerator (Wnd: hWnd; cm: TContextMenu): Boolean; stdcall;
var
    szBuffer: array [0..255] of Char;
begin
    Result := True;
    GetClassName (Wnd, szBuffer, sizeof (szBuffer));
    if CompareText (szBuffer, 'TTabControl') = 0 then begin
        Result := False;
        cm.TabControlWindow := Wnd;
    end;
end;

function EditControlEnumerator (Wnd: hWnd; cm: TContextMenu): Boolean; stdcall;
var
    szBuffer: array [0..255] of Char;
begin
    Result := True;
    GetClassName (Wnd, szBuffer, sizeof (szBuffer));
    if CompareText (szBuffer, 'TEditControl') = 0 then begin
        Result := False;
        cm.EditControl := Wnd;
    end;
end;

procedure TContextMenu.DropOnDelphi;
var
    EditWindow: hWnd;
begin
    EditWindow := FindWindow ('TEditWindow', Nil);
    if EditWindow <> 0 then begin
        TabControlWindow := 0;
        EnumChildWindows (EditWindow, @TabControlEnumerator, Integer (Self));
        if TabControlWindow <> 0 then begin
            EditControl := 0;
            EnumChildWindows (EditWindow, @EditControlEnumerator, Integer (Self));
            if (EditControl <> 0) and (hGlobal <> 0) then begin
                SendMessage (EditControl, wm_DropFiles, hGlobal, 0);
            end;
        end;
    end;
end;

// The Shell calls this method when it's time for the context menu handler to
// add its own custom menu entries to the menu itself.  We return the number
// of entries that we've added.

function TContextMenu.QueryContextMenu (Menu: hMenu; indexMenu, idCmdFirst,
                                        idCmdLast, uFlags: uInt): HResult;
begin
    InsertMenu (Menu, indexMenu, mf_String or mf_ByPosition, idCmdFirst, 'Open in Delphi');
    Result := 1;
end;

// The Shell calls this method when our custom menu item has been clicked by
// the user.  In other words - it's time to do the business...

function TContextMenu.InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult;
begin
    // Ensure we're not being called by an application
    Result := E_Fail;
    if HiWord (Integer (lpici.lpVerb)) <> 0 then Exit;

    // Verb can only be zero since we only installed one menu item
    Result := E_InvalidArg;
    if LoWord (lpici.lpVerb) <> 0 then Exit;

    // Execute the notepad with the specified file
    Result := NoError;
    DropOnDelphi;
end;

// The Shell calls this method to get a 'hint' string for the custom menu item

function TContextMenu.GetCommandString (idCmd, uType: uInt; pwReserved: puInt;
                                        pszName: LPSTR; cchMax: uInt): HRESULT;
begin
    Result := E_InvalidArg;
    if idCmd = 0 then begin
        strCopy (pszName, 'Open the selected source file in Delphi');
        Result := NOERROR;
    end;
end;

function TContextMenu.Initialize (pidlFolder: PItemIDList; lpdobj: IDataObject;
                                  hKeyProgID: HKEY): HResult;
var
    medium: TStgMedium;
    fe: TFormatEtc;
    pSrc, pDst: PChar;
begin
    with fe do begin
        cfFormat := CF_HDROP;
        ptd := Nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := -1;
        tymed := TYMED_HGLOBAL;
    end;

    // Fail the call if lpdobj is Nil.
    Result := E_Fail;
    if lpdobj = Nil then Exit;

    // Render the data referenced by the IDataObject pointer to an HGLOBAL
    // storage medium in CF_HDROP format.
    Result := lpdobj.GetData(fe, medium);
    if Failed (Result) then Exit;

    // If only one file is selected, copy global handle.
    // Otherwise fail the call.
    if DragQueryFile (medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
    begin
        { Copy the global handle }
        hGlobal := GlobalAlloc (gmem_Moveable, GlobalSize (medium.hGlobal));
        pSrc := GlobalLock (medium.hGlobal);  pDst := GlobalLock (hGlobal);
        Move (pSrc^, pDst^, GlobalSize (medium.hGlobal));
        GlobalUnlock (medium.hGlobal);  GlobalUnlock (hGlobal);
        Result := NOERROR;
    end
    else Result := E_Fail;

    ReleaseStgMedium (medium);
end;

initialization
    TComObjectFactory.Create (ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
                             '', 'Delphi 3.0 ContextMenu Example', ciMultiInstance);

end.